module Text.XML.Xmlable.FromTagSoup where

import Text.HTML.TagSoup
import Text.XML.Xmlable.Xmlable
import Data.Char
import Data.List
import Data.Maybe
import qualified Data.Map as Map
import Control.Arrow(first)
import Control.Monad

fromTS :: [Tag String] -> [Xml]
fromTS xs = go xs
    where
        go [] = []
        go ((TagOpen s atrs) : xs) 
            | "?" `isPrefixOf` s = go xs
            | otherwise = ElemB s (
                    mapNS `Map.union` Map.fromList (
                            (\(pa, a) -> if null a then [] else fromMaybe [] $ liftM ((:[]) . (,) "") $ Map.lookup pa mapNS ) $ 
                                    break (==':') s
                        )
                ) : map (uncurry Attr) (filter (not . isPrefixOf "xmlns:" . fst) atrs) ++ go xs
            where
                mapNS = Map.fromList $ map (first (\\"xmlns:")) $ filter (isPrefixOf "xmlns:" . fst) atrs
        go ((TagClose s) : xs) = ElemE : go xs
        go ((TagText s) : xs) 
            | any isAlphaNum (take 1 $ dropWhile isSpace s) = Val (trim s) : go xs
            | otherwise = go xs
            where
                bidi f = reverse . f . reverse . f
                trim = bidi $ dropWhile isSpace
        go (_ : xs) = go xs

{-
    Suppose that attributes are before elements
-}

toTS xs = toTS' (((True, []), []), xs)
    where
        toTS' (((b, ns), as), xs) | b `seq` False = [] 
        toTS' (((True, []), _), []) = []
        toTS' (((False, []), _), xs) = error "toTS: Element is not closed"
        toTS' (((_, ns), _), []) = error $ "toTS: Element <" ++ head ns ++ "> is not closed"
        toTS' (((True, ns), _), Attr n v : xs) = error $ "Element is closed already for " ++ show (Attr n v)
        toTS' (((True, []), _), ElemE : xs) = error "Element is closed already"

        toTS' (((False, (s:ss)), as), Attr n v : xs) = toTS' (((False, s:ss), (n,v):as), xs)

        toTS' (((False, s), as), xxs) = TagOpen (head s) as : toTS' (((True, s), []), xxs)
        toTS' (((True, s), as), ElemB n ns : xs) = toTS' (((False, n : s), 
                map (first ("xmlns:"++)) $ filter (not . null . fst) $ Map.toList ns), xs)
        toTS' (a@((True, s), as), Val v : xs) = TagText v : toTS' (a, xs)
        toTS' (((True, n:ss), as), ElemE : xs) = TagClose n : toTS' (((True, ss), as), xs)
